Chip 1997 October/CD CHIP.ISO/WebServ/server7/bin/ISAPIGetAndPost.dpr

Text File | 1996-07-03 | 6.3 KB | 230 lines

library ISAPIGetAndPost;

uses
  Windows,
  SysUtils,
  Classes,
  ISAPISock,
  Httpext,
  Parser;

procedure ProcessGet(sock: TISAPISock);
var
  fin: TextFile;
  s: String;
begin
  try
    with sock do
    begin
      // Send a HTML header
      Writeln('HTTP/1.0 200 OK');
      Writeln('Content-type: text/html');
      // Make this document expire immediately
      Writeln('Expires: 0');
      Writeln('');

      // Start the HTML Document
      HHeader( 'PageBoy Database: Remote Configuration', hcLtGray, hcBlack, hcBlue );
      HPageStart;

      HSeparator;
      HImage( 'pageboy.gif' );
      HHeading(1,'PageBoy Database: Remote Configuration');
      HSeparator;

      //HLine( HBold('NOTE:') + ' PageBoy will automatically use this centralized database if you choose "Database-Remote" from the PageBoy menu.' );

      //HSeparator;

      Writeln( HBold(HItalic('Instructions: '))+'To add another user to the PageBoy database, fill out the form below and click on the submit button. This will allow all users of PageBoy');
      Writeln(' to then use that entry if they choose '+HBold('DATABASE-REMOTE')+' from the PageBoy menu.');

      HFormStart('POST', '/bin/ISAPIGetAndPost.dll');

      HEditBox('   Last Name: ', 'LastName',    '', 50, 20);
      HEditBox('  First Name: ', 'FirstName',   '', 50, 20);
      HEditBox('Pager Number: ', 'PagerNumber', '', 50, 20);

      HFormEnd('Submit','');
      HSeparator;
      HLine( HCenter(HFontSize(HBold('Current Entries'), 5)) );
      HLine('*****');
      AssignFile(fin, ExtractFilePath(GetServerVariable('SCRIPT_NAME'))+'database.txt');
      try
        Reset(fin);
        try
          while NOT EOF(fin) do
          begin
            System.ReadLn(fin, s);
            HLine(s);
          end;
        finally
          CloseFile(fin);
        end;
      except
        // Something went wrong reading in the DB
        HLine('An error occurred while reading the database '+ExtractFilePath(GetServerVariable('SCRIPT_NAME'))+'database.txt');
      end;
      HLine('*****');
      HSeparator;
      HSeparator;
      HPageEnd;
    end;
  except
     // Something went wrong performing the GET
  end;
end;

procedure ProcessPost(sock: TISAPISock);
var
  fin, fout: TextFile;
  database: TStringList;
  s, token, field, value: String;
  i: Integer;
  lastName, firstName, pager: String;
begin
  database:=TStringList.Create;

  try
    with sock do
    begin
      // Make the string list sorted, and ignore/reject duplicates
      database.Sorted:=True;
      database.Duplicates:=dupIgnore;

      // Send a HTML header
      Writeln('HTTP/1.0 200 OK');
      Writeln('Content-type: text/html');
      Writeln('Expires: 0');
      Writeln('');

      // Parse out the post
      lastName:= GetFormVal('LastName');
      firstName:=GetFormVal('FirstName');
      pager:=    GetFormVal('PagerNumber');

      // Check if it's valid
      if (lastName<>'') AND (firstName<>'') AND (pager<>'') then
      begin

        // Tell the user he did good
        HHeader( 'PageBoy Data Accepted', hcLtGray, hcBlack, hcBlue );
        HPageStart;

        HSeparator;
        HHeading(1,'PageBoy Data Accepted.');
        HSeparator;

        // Show it to the user
        HLine( HBold('Name: ')+lastName+', '+firstName);
        HLine( HBold('Pager: ')+pager);

        HLine('Select '+HBold('DATABASE-REMOTE')+' from the PageBoy menu to reflect this change in your copy of PageBoy.');
        HSeparator;

        // Add it to the database
        database.Add(lastName+', '+firstName+' ('+pager+')');

        // Read in the existing data
        AssignFile(fin, ExtractFilePath(GetServerVariable('SCRIPT_NAME'))+'database.txt');
        try
          Reset(fin);
          try
            while NOT EOF(fin) do
            begin
              System.ReadLn(fin, s);
              database.Add(s);
            end;
          finally
            CloseFile(fin);
          end;
        except
          // Something went wrong reading in the DB
          HLine('An error occurred while reading the database '+ExtractFilePath(GetServerVariable('SCRIPT_NAME'))+'database.txt');
        end;

        // Now write it back out, including the new entry
        AssignFile(fout, ExtractFilePath(GetServerVariable('SCRIPT_NAME'))+'database.txt');
        try
          Rewrite(fout);
          try
            for i:=0 to database.Count-1 do
            begin
              System.Writeln(fout, database[i]);
            end;
          finally
            CloseFile(fout);
          end;
        except
           HLine('An error occurred while reading the database '+ExtractFilePath(GetServerVariable('SCRIPT_NAME'))+'database.txt');
        end;
      end
      else
      begin
        // Tell the user he goofed
        HHeader( 'PageBoy Data Rejected', hcLtGray, hcBlack, hcBlue );
        HPageStart;

        HSeparator;
        HHeading(1,'PageBoy Data Rejected.');
        HSeparator;
        HLine('All fields must be filled in!');
        HSeparator;
      end;

      HPageEnd;
    end;
  finally
    database.Free;
  end;
end;

// CASE MATTERS FOR THIS FUNCTION NAME
function GetExtensionVersion(var ver: THSE_VERSION_INFO): Boolean; stdcall;
begin
  result:=True;
end;

// CASE MATTERS FOR THIS FUNCTION NAME
function HttpExtensionProc(var ecb: TEXTENSION_CONTROL_BLOCK): LongInt; stdcall;
var
  sock: TISAPISock;
  method: String;
begin
  // Create the socket helper
  sock:=TISAPISock.Create(ecb);

  method:=sock.GetServerVariable('REQUEST_METHOD');
  if method='GET' then
    ProcessGet(sock)
  else if method='POST' then
  begin
    ProcessPost(sock)
  end
  else
  begin
    sock.Writeln('HTTP/1.0 200 OK');
    sock.Writeln('Content-type: text/html');
    sock.Writeln('');
    sock.Writeln('I didn''t understand that request');
  end;


  // Return a normal status code
  StrLCopy( ecb.lpszLogData, PChar('DLL Finished with no errors'), HSE_LOG_BUFFER_LEN-1);
  Result:=HSE_STATUS_SUCCESS;

  // Free the socket
  sock.Free;
end;

// * REQUIRED FOR DYNAMIC BINDING.
// * Index values aren't need.
// * Case doesn't matter here.
exports
  GetExtensionVersion,
  HttpExtensionProc;

begin
end.